home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / spiele / workbench spiele / krsnake / src / krsnake.e < prev    next >
Text File  |  1996-02-21  |  35KB  |  1,142 lines
  1. ->
  2. -> ANNVIT CÆPTIS MDCCLXXVI!
  3. ->
  4. ->      KRSNAke v1.17 Stab
  5. ->
  6. -> $NSAREG: 23F07N07OR2748D5944.7 [Fnord!]
  7. ->
  8. -> Copyright © 1995, 1996 Psilocybe Software
  9. ->
  10. -> This program is free software; you can redistribute it and/or modify
  11. -> it under the terms of the GNU General Public License as published by
  12. -> the Free Software Foundation; either version 2 of the License, or
  13. -> (at your option) any later version.
  14. ->
  15. -> This program is distributed in the hope that it will be useful,
  16. -> but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. -> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. -> GNU General Public License for more details.
  19. ->
  20. -> You should have received a copy of the GNU General Public License
  21. -> along with this program; if not, write to the Free Software
  22. -> Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23. ->
  24. -> $HISTORY:
  25. ->
  26. -> 22 Feb 1996 : 001.017 :  Notifies user about important dates :)
  27. -> 26 Jan 1996 : 001.016 :  Optimised and debugged ARexx interface
  28. -> 24 Oct 1995 : 001.015 :  Uses new server notification system
  29. -> 24 Oct 1995 : 001.014 :  Resets itself when prefs are changed
  30. -> 19 Oct 1995 : 001.013 :  Graphic snake is scaled and masked
  31. -> 14 Oct 1995 : 001.012 :  Snake can be graphic now
  32. -> 13 Oct 1995 : 001.011 :  Added locale support
  33. -> 08 Oct 1995 : 001.010 :  Optimised the score updating a little.
  34. -> 08 Oct 1995 : 001.009 :  Oops.. Rnd() wasn't properly seeded. Fixed now.
  35. -> 22 Sep 1995 : 001.008 :  Now is a commodity, can appear/disappear.
  36. -> 19 Sep 1995 : 001.007 :  Added ARexx port and cleaned up imsg handling.
  37. -> 10 Sep 1995 : 001.006 :  Uses new prefs system and datatype backgrounds.
  38. -> 12 Jul 1995 : 001.005 :  Uses krsnake.library instead of internal c/s code.
  39. -> 11 Jul 1995 : 001.004 :  Autostarts clients.
  40. -> 07 Jul 1995 : 001.003 :  Now sends SNAKE_MOVES event to clients.
  41. -> 27 Jun 1995 : 001.002 :  Added client/server interface.
  42. -> 23 Jun 1995 : 001.001 :  Initial revision
  43. ->
  44. -> NOVUS ORDO SECLORUM!
  45. ->
  46.  
  47. OPT OSVERSION=39
  48. OPT PREPROCESS
  49.  
  50. MODULE 'intuition/intuition','intuition/screens','dos/dos','graphics/text'
  51. MODULE 'graphics/view','datatypes/datatypes','datatypes/datatypesclass'
  52. MODULE 'datatypes/soundclass','datatypes','exec/execbase','exec/lists','utility'
  53. MODULE 'exec/semaphores','exec/nodes','dos/dostags','exec/libraries','dos/dosextens'
  54. MODULE 'krsnake','libraries/krsnake','tools/trapguru','exec/ports'
  55. MODULE 'libraries/lowlevel','lowlevel','datatypes/pictureclass','graphics/gfx'
  56. MODULE 'commodities','libraries/commodities','tools/ports','amigalib/cx'
  57. MODULE 'wb','icon','workbench/workbench','locale','utility/tagitem'
  58. MODULE 'tools/arexx','rexx/errors','utility/date','class/hash','other/split'
  59.  
  60. MODULE '*tiledbitmap','*krsnakecat','*graphic'
  61.  
  62. RAISE   "SCR"   IF  LockPubScreen()=0,
  63.         "WIN"   IF  OpenWindowTagList()=0,
  64.         "DRI"   IF  GetScreenDrawInfo()=0,
  65.         "FONT"  IF  OpenFont()=0,
  66.         "DOBJ"  IF  AllocDosObject()=0,
  67.         "LSEG"  IF  LoadSeg()=0,
  68.         "CXBR"  IF  CxBroker()=0,
  69.         "PORT"  IF  CreateMsgPort()=0
  70.  
  71. #define KRSNAKEVER {krsnakever}+6
  72.  
  73. OBJECT rexxcommand OF hashlink
  74.     id:INT
  75. ENDOBJECT
  76.  
  77. DEF krs=0
  78. DEF w=0:PTR TO window,s=0:PTR TO screen,dri=0:PTR TO drawinfo
  79. DEF font:PTR TO textfont,dripens[NUMDRIPENS]:ARRAY OF INT
  80. DEF bw=4,bh=4,fw=128,fh=128,fy,ww,wh,wx=0,wy=-1,th
  81. DEF chunk=0,hx=15,hy=15,sx=0,sy=-1,eaten=0,playing=0,cx=-1,cy=-1,counter=3,speed=3
  82. DEF fifox[1024]:ARRAY OF INT,fifoy[1024]:ARRAY OF INT,fifos=0,fifoe=0,fifol=1
  83. DEF matrix[1024]:ARRAY OF INT,killtask=FALSE,gameover=0
  84. DEF keybuf[256]:ARRAY OF CHAR,keybufs=1,keybufe=0,keybufl=0
  85. DEF fillp[7]:ARRAY OF LONG,datatype[7]:ARRAY OF LONG,cp=0,paused=0
  86. DEF wantobtainpens=0,pensobtained=0,visible=0
  87. DEF bgs=0,efs=0,crs=0,nsx,nsw,nsh
  88. DEF kp=0:PTR TO kprefs,rexxPort=0:PTR TO mp
  89. DEF broker=0,brokerPort=0:PTR TO mp
  90. DEF appicon=0,appmenu=0,myicon=0:PTR TO diskobject,appPort=0:PTR TO mp
  91. DEF head,graphic[7]:ARRAY OF LONG,newprefs=0
  92. DEF rexxwait=0,rexxwaitmode=0,rexxhash=0:PTR TO hashtable
  93.  
  94. ENUM CXID_POPKEY=1
  95. ENUM APPID_ICON=1,APPID_MENU
  96.  
  97. ENUM AREXX_ERROR=0,
  98.      AREXX_CHECK=1,
  99.      AREXX_DOWN,
  100.      AREXX_GET,
  101.      AREXX_HIDE,
  102.      AREXX_LEFT,
  103.      AREXX_NEWGAME,
  104.      AREXX_PAUSE,
  105.      AREXX_QUIT,
  106.      AREXX_RIGHT,
  107.      AREXX_SET,
  108.      AREXX_SHOW,
  109.      AREXX_UP,
  110.      AREXX_WAIT,
  111.      AREXX_MAX
  112.  
  113.  
  114. PROC randomise()
  115.     DEF ds:datestamp
  116.     DateStamp(ds)
  117.     Rnd(0-And(ds.tick+ds.days+ds.minute,$7fffffff))
  118. ENDPROC
  119.  
  120. PROC launchclients() HANDLE
  121.     DEF fib=0:PTR TO fileinfoblock,lock=0,olddir,cc=0
  122.     fib:=AllocDosObject(DOS_FIB,NIL)
  123.     lock:=Lock('PROGDIR:Clients',ACCESS_READ)
  124.     IF lock=0 THEN Raise(1)
  125.     IF Examine(lock,fib)
  126.         olddir:=CurrentDir(lock)
  127.         WHILE ExNext(lock,fib)
  128.             IF fib.direntrytype<0
  129.                 IF launchClient(fib.filename)=0 THEN INC cc
  130.             ENDIF
  131.         ENDWHILE
  132.         CurrentDir(olddir)
  133.     ENDIF
  134. EXCEPT DO
  135.     IF lock THEN UnLock(lock)
  136.     IF fib THEN FreeDosObject(DOS_FIB,fib)
  137.     IF exception>1 THEN ReThrow()
  138. ENDPROC
  139.  
  140. PROC launchClient(name) IS SystemTagList(name,[SYS_ASYNCH,TRUE,SYS_INPUT,NIL,SYS_OUTPUT,NIL,TAG_DONE])
  141.  
  142. PROC readsounds()
  143.     IF StrLen(kp.startgamesound) THEN bgs:=KsReadSoundObject(kp.startgamesound)
  144.     IF StrLen(kp.eatfruitsound) THEN efs:=KsReadSoundObject(kp.eatfruitsound)
  145.     IF StrLen(kp.crashsound) THEN crs:=KsReadSoundObject(kp.crashsound)
  146. ENDPROC
  147.  
  148. PROC freesounds()
  149.     KsDeleteSoundObject(bgs)
  150.     KsDeleteSoundObject(efs)
  151.     KsDeleteSoundObject(crs)
  152.     bgs:=0
  153.     efs:=0
  154.     crs:=0
  155. ENDPROC
  156.  
  157. PROC obtainpen(a)
  158.     SELECT 4 OF kp.fill[a].type
  159.         CASE FILLTYPE_RGB
  160.             fillp[a]:=ObtainBestPenA(s.viewport.colormap,v32(kp.fill[a].red),v32(kp.fill[a].green),v32(kp.fill[a].blue),[OBP_PRECISION,PRECISION_EXACT,NIL])
  161.         CASE FILLTYPE_DATATYPE
  162.             datatype[a]:=createImageData(kp.fill[a].file,s)
  163.         CASE FILLTYPE_GRAPHIC
  164.             graphic[a]:=loadGraphic(kp.fill[a].file,s)
  165.     ENDSELECT
  166. ENDPROC
  167.  
  168. PROC scaleGraphics()
  169.     DEF i
  170.     FOR i:=0 TO 6
  171.         IF kp.fill[i].type=FILLTYPE_GRAPHIC THEN scaleGraphic(graphic[i],bw,bh,s)
  172.     ENDFOR
  173. ENDPROC
  174.  
  175. PROC v32(x) IS Or(Shl(x,24),Or(Shl(x,16),Or(Shl(x,8),x)))
  176.  
  177. PROC obtainpens()
  178.     DEF gfxver,a
  179.     MOVE.L  gfxbase,A0
  180.     MOVE.W  20(A0),gfxver
  181.     IF gfxver>=39
  182.         pensobtained:=1
  183.         FOR a:=0 TO 6 DO obtainpen(a)
  184.     ENDIF
  185. ENDPROC
  186.  
  187. PROC freepens()
  188.     DEF a
  189.     FOR a:=0 TO 6
  190.         SELECT 4 OF kp.fill[a].type
  191.             CASE FILLTYPE_RGB
  192.                 IF fillp[a]<>-1 THEN ReleasePen(s.viewport::viewport.colormap,fillp[a])
  193.             CASE FILLTYPE_DATATYPE
  194.                 IF datatype[a] THEN disposeImageData(datatype[a])
  195.             CASE FILLTYPE_GRAPHIC
  196.                 IF graphic[a] THEN freeGraphic(graphic[a])
  197.         ENDSELECT
  198.         fillp[a]:=-1
  199.         datatype[a]:=0
  200.         graphic[a]:=0
  201.     ENDFOR
  202. ENDPROC
  203.  
  204. PROC dumpsettings() HANDLE
  205.     DEF f=0
  206.     f:=Open('ENVARC:KRSNAke/KRSNAke.snapshot',MODE_NEWFILE)
  207.     IF f=0 THEN Raise("URK")
  208.     VfPrintf(f,'%ld\n%ld\n%ld\n%ld\n%ld\n',[w.leftedge,w.topedge,bw,bh,speed])
  209. EXCEPT DO
  210.     IF f THEN Close(f)
  211. ENDPROC
  212.  
  213. PROC readnumeral(f)
  214.     DEF i,b[256]:ARRAY OF CHAR
  215.     IF (Fgets(f,b,255)=0) THEN Raise("URK")
  216.     i:=Val(b)
  217. ENDPROC i
  218.  
  219. PROC readsettings()
  220.     DEF f=0
  221.     kp:=KsReadKRSNAkePrefs()
  222.     IF kp=0 THEN Raise("Pref")
  223.     wantobtainpens:=TRUE
  224.     IF (f:=Open('ENVARC:KRSNAke/KRSNAke.snapshot',MODE_OLDFILE))
  225.         wx:=readnumeral(f)
  226.         wy:=readnumeral(f)
  227.         bw:=readnumeral(f)
  228.         fw:=bw*32
  229.         bh:=readnumeral(f)
  230.         fh:=bh*32
  231.         speed:=readnumeral(f)
  232.         Close(f)
  233.     ENDIF
  234. ENDPROC
  235.  
  236. PROC bevelbox(x1,y1,x2,y2,dir=TRUE,bf=0)
  237.     DEF shine,shadow
  238.     IF dir
  239.         shine:=dripens[SHINEPEN]
  240.         shadow:=dripens[SHADOWPEN]
  241.     ELSE
  242.         shine:=dripens[SHADOWPEN]
  243.         shadow:=dripens[SHINEPEN]
  244.     ENDIF
  245.     SetAPen(stdrast,shine)
  246.     RectFill(stdrast,x1,y1,x1,y2)
  247.     RectFill(stdrast,x1+1,y1,x2-1,y1)
  248.     SetAPen(stdrast,shadow)
  249.     RectFill(stdrast,x1+1,y2,x2,y2)
  250.     RectFill(stdrast,x2,y1,x2,y2-1)
  251.     IF bf
  252.         SetAPen(stdrast,bf)
  253.         RectFill(stdrast,x1+1,y1+1,x2-1,y2-1)
  254.     ENDIF
  255. ENDPROC
  256.  
  257. PROC renderlink(x,y,p)
  258.     DEF sx,sy,a
  259.     sx:=(x*bw)+4
  260.     sy:=(y*bh)+fy
  261.     IF kp.fill[p].type<>FILLTYPE_GRAPHIC
  262.         IF p>FILL_BACK
  263.             bevelbox(sx,sy,sx+bw-1,sy+bh-1,TRUE)
  264.             renderfill(sx+1,sy+1,sx+bw-2,sy+bh-2,p)
  265.         ELSE
  266.             renderfill(sx,sy,sx+bw-1,sy+bh-1,FILL_BACK)
  267.         ENDIF
  268.     ELSE
  269.         IF p<FILL_FRUIT1 THEN a:=matrix[(y*32)+x]-1 ELSE a:=0
  270.         drawGraphic(stdrast,graphic[p],a,sx,sy)
  271.     ENDIF
  272. ENDPROC
  273.  
  274. PROC renderfill(x1,y1,x2,y2,p)
  275.     DEF r:rectangle,d:PTR TO imagedata
  276.     SELECT 4 OF kp.fill[p].type
  277.         CASE FILLTYPE_RGB
  278.             SetAPen(stdrast,fillp[p])
  279.             RectFill(stdrast,x1,y1,x2,y2)
  280.         CASE FILLTYPE_DRIPEN
  281.             SetAPen(stdrast,dripens[kp.fill[p].dripen])
  282.             RectFill(stdrast,x1,y1,x2,y2)
  283.         CASE FILLTYPE_DATATYPE
  284.             d:=datatype[p]
  285.             r.minx:=x1
  286.             r.maxx:=x2
  287.             r.miny:=y1
  288.             r.maxy:=y2
  289.             copyTiledBitMap(d,stdrast,r)
  290.     ENDSELECT
  291. ENDPROC
  292.  
  293. PROC rendersnake()
  294.     DEF i,p
  295.     renderfill(4,fy,fw+3,fh+fy-1,FILL_BACK)
  296.     i:=fifol
  297.     p:=fifos
  298.     REPEAT
  299.         IF i>1
  300.             renderlink(fifox[p],fifoy[p],FILL_LINK)
  301.         ELSE
  302.             renderlink(fifox[p],fifoy[p],FILL_HEAD)
  303.         ENDIF
  304.         p:=p+1
  305.         IF p>=1024 THEN p:=0
  306.         i:=i-1
  307.     UNTIL i=0
  308.     IF (cx>=0) AND (cy>=0) THEN renderlink(cx,cy,FILL_FRUIT+cp)
  309. ENDPROC
  310.  
  311. PROC pushlink(x,y,l)
  312.     fifoe:=fifoe+1
  313.     fifol:=fifol+1
  314.     IF fifoe>=1024 THEN fifoe:=0
  315.     fifox[fifoe]:=x
  316.     fifoy[fifoe]:=y
  317.     matrix[(y*32)+x]:=l
  318. ENDPROC
  319.  
  320. PROC poplink()
  321.     DEF x,y,l
  322.     x:=fifox[fifos]
  323.     y:=fifoy[fifos]
  324.     l:=matrix[(y*32)+x]
  325.     fifos:=fifos+1
  326.     fifol:=fifol-1
  327.     IF fifos>=1024 THEN fifos:=0
  328.     matrix[(y*32)+x]:=0
  329. ENDPROC x,y,l
  330.  
  331. PROC pushkey(key)
  332.     IF (key<$80) AND (key<>keybuf[keybufe])
  333.         keybufe:=keybufe+1
  334.         keybufl:=keybufl+1
  335.         IF keybufe>=256 THEN keybufe:=0
  336.         keybuf[keybufe]:=key
  337.     ENDIF
  338. ENDPROC
  339.  
  340. PROC popkey()
  341.     DEF key
  342.     IF keybufl<=0 THEN RETURN 0
  343.     key:=keybuf[keybufs]
  344.     keybufs:=keybufs+1
  345.     keybufl:=keybufl-1
  346.     IF keybufs>=256 THEN keybufs:=0
  347. ENDPROC key
  348.  
  349. PROC renderscore(redraw=TRUE,newscore=FALSE)
  350.     DEF ss[64]:STRING
  351.     IF redraw
  352.         SetAPen(stdrast,dripens[BACKGROUNDPEN])
  353.         IF newscore
  354.             RectFill(stdrast,nsx,3,nsx+nsw-1,2+nsh)
  355.         ELSE
  356.             RectFill(stdrast,1,3,ww-2,th+2)
  357.         ENDIF
  358.     ENDIF
  359.     IF playing THEN lStringF(ss,getstr(ID_INGAMESTATUS),[fifol,chunk])
  360.     IF (playing=0) AND (gameover=0) THEN lStringF(ss,getstr(ID_INITIALSTATUS),[bw,bh])
  361.     IF (playing=0) AND (gameover=1) THEN lStringF(ss,getstr(ID_GAMEOVERSTATUS),[fifol])
  362.     nsw:=TextLength(stdrast,ss,EstrLen(ss))
  363.     SetAPen(stdrast,dripens[TEXTPEN])
  364.     nsx:=(ww-nsw)/2
  365.     nsh:=font.ysize
  366.     Move(stdrast,nsx,3+font.baseline)
  367.     Text(stdrast,ss,EstrLen(ss))
  368. ENDPROC
  369.  
  370. PROC render()
  371.     DEF rw,rh
  372.     ww:=w.width-w.borderleft-w.borderright
  373.     wh:=w.height-w.bordertop-w.borderbottom
  374.     fw:=ww-8
  375.     fh:=wh-th-14
  376.     fy:=th+10
  377.     bw:=fw/32
  378.     bh:=fh/32
  379.     rw:=bw*32
  380.     rh:=bh*32
  381.     IF (fw-rw) OR (fh-rh) THEN JUMP done
  382.  
  383.     scaleGraphics()
  384.     SetRast(stdrast,dripens[BACKGROUNDPEN])
  385.     bevelbox(0,0,ww-1,th+5)
  386.     bevelbox(0,fy-4,ww-1,wh-1)
  387.     bevelbox(3,fy-1,ww-4,wh-4,FALSE)
  388.     renderscore(FALSE)
  389.     rendersnake()
  390. done:
  391. ENDPROC
  392.  
  393. PROC verifysize()
  394.     DEF rw,rh,aw,ah
  395.     aw:=w.width
  396.     ah:=w.height
  397.     fw:=aw-w.borderleft-w.borderright-8
  398.     fh:=ah-w.bordertop-w.borderbottom-th-14
  399.     bw:=fw/32
  400.     bh:=fh/32
  401.     rw:=bw*32
  402.     rh:=bh*32
  403.     IF (fw-rw) OR (fh-rh)
  404.         aw:=aw-(fw-rw)
  405.         ah:=ah-(fh-rh)
  406.         ChangeWindowBox(w,w.leftedge,w.topedge,aw,ah)
  407.     ENDIF
  408. ENDPROC
  409.  
  410. PROC newchunk()
  411.     REPEAT
  412.         cx:=Rnd(32)
  413.         cy:=Rnd(32)
  414.     UNTIL matrix[(cy*32)+cx]=0
  415.     chunk:=Rnd(9)+1
  416.     cp:=Rnd(4)
  417.     KsNotifyClients(krs,SNAKE_NEWCHUNK,Shl(chunk,24) OR Shl(cp,16) OR Shl(cy,8) OR cx)
  418.     renderlink(cx,cy,FILL_FRUIT+cp)
  419. ENDPROC
  420.  
  421. PROC transformhead(x,y,h)
  422.     DEF p,nh
  423.     p:=(y*32)+x
  424.     nh:=matrix[p]
  425.     SELECT nh
  426.         CASE 5
  427.             SELECT h
  428.                 CASE 5
  429.                     matrix[p]:=1
  430.                 CASE 6
  431.                     matrix[p]:=15
  432.                 CASE 8
  433.                     matrix[p]:=16
  434.             ENDSELECT
  435.         CASE 6
  436.             SELECT h
  437.                 CASE 5
  438.                     matrix[p]:=14
  439.                 CASE 6
  440.                     matrix[p]:=2
  441.                 CASE 7
  442.                     matrix[p]:=20
  443.             ENDSELECT
  444.         CASE 7
  445.             SELECT h
  446.                 CASE 6
  447.                     matrix[p]:=17
  448.                 CASE 7
  449.                     matrix[p]:=3
  450.                 CASE 8
  451.                     matrix[p]:=18
  452.             ENDSELECT
  453.         CASE 8
  454.             SELECT h
  455.                 CASE 5
  456.                     matrix[p]:=13
  457.                 CASE 7
  458.                     matrix[p]:=19
  459.                 CASE 8
  460.                     matrix[p]:=4
  461.             ENDSELECT
  462.     ENDSELECT
  463. ENDPROC
  464.  
  465. PROC transformtail(x,y)
  466.     DEF p,h
  467.     p:=(y*32)+x
  468.     h:=matrix[p]
  469.     SELECT 21 OF h
  470.         CASE 1,5,13,14
  471.             matrix[p]:=9
  472.         CASE 2,6,15,17
  473.             matrix[p]:=10
  474.         CASE 3,7,19,20
  475.             matrix[p]:=11
  476.         CASE 4,8,16,18
  477.             matrix[p]:=12
  478.     ENDSELECT
  479. ENDPROC
  480.  
  481. PROC movesnake()
  482.     DEF alive=1,x,y,key
  483.     key:=popkey()
  484.     IF paused=1
  485.         IF key
  486.             KsNotifyClients(krs,SNAKE_RESTARTED,fifol)
  487.             WaitTOF()
  488.             paused:=0
  489.         ELSE
  490.             RETURN 1
  491.         ENDIF
  492.     ENDIF
  493.     IF playing=0
  494.         IF key=$40
  495.             resetgame()
  496.         ELSE
  497.             RETURN 0
  498.         ENDIF
  499.     ENDIF
  500.     IF (key>0) AND (key<11)
  501.         speed:=key
  502.     ELSE
  503.         SELECT key
  504.             CASE $4C
  505.                 IF (sy<>1) OR And(kp.flags,KPF_LETHAL180)
  506.                     sx:=0
  507.                     sy:=-1
  508.                     head:=8
  509.                 ENDIF
  510.             CASE $4D
  511.                 IF (sy<>-1) OR And(kp.flags,KPF_LETHAL180)
  512.                     sx:=0
  513.                     sy:=1
  514.                     head:=6
  515.                 ENDIF
  516.             CASE $4E
  517.                 IF (sx<>-1) OR And(kp.flags,KPF_LETHAL180)
  518.                     sx:=1
  519.                     sy:=0
  520.                     head:=5
  521.                 ENDIF
  522.             CASE $4F
  523.                 IF (sx<>1) OR And(kp.flags,KPF_LETHAL180)
  524.                     sx:=-1
  525.                     sy:=0
  526.                     head:=7
  527.                 ENDIF
  528.             CASE $45
  529.                 killtask:=TRUE
  530.             CASE $19
  531.                 KsNotifyClients(krs,SNAKE_PAUSED,fifol)
  532.                 WaitTOF()
  533.                 paused:=1
  534.         ENDSELECT
  535.     ENDIF
  536.     hx:=hx+sx
  537.     hy:=hy+sy
  538.     SELECT 4 OF rexxwaitmode
  539.         CASE 1
  540.             IF hx=rexxwait THEN rexxwaitmode:=0
  541.             IF rexxwaitmode=0 THEN rexxwait:=0
  542.             checkRexxCommands()
  543.         CASE 2
  544.             IF hy=rexxwait THEN rexxwaitmode:=0
  545.             IF rexxwaitmode=0 THEN rexxwait:=0
  546.             checkRexxCommands()
  547.         CASE 3
  548.             IF rexxwait>0 THEN DEC rexxwait
  549.             IF rexxwait=0 THEN rexxwaitmode:=0
  550.             checkRexxCommands()
  551.         DEFAULT
  552.             rexxwait:=0
  553.             rexxwaitmode:=0
  554.     ENDSELECT
  555.  
  556.     IF (hx<0) OR (hx>31) OR (hy<0) OR (hy>31) OR (matrix[(hy*32)+hx]>0) OR (fifol>=1023)
  557.         KsNotifyClients(krs,SNAKE_GAMEOVER,fifol)
  558.         KsPlaySoundObject(crs)
  559.         alive:=0
  560.         playing:=0
  561.         gameover:=1
  562.         keybufs:=1
  563.         keybufe:=0
  564.         keybufl:=0
  565.         rexxwait:=0
  566.         rexxwaitmode:=0
  567.         renderscore()
  568.     ELSE
  569.         KsNotifyClients(krs,SNAKE_MOVES,Shl(head,16) OR Shl(hy,8) OR hx)
  570.         transformhead(fifox[fifoe],fifoy[fifoe],head)
  571.         IF kp.fill[FILL_LINK].type=FILLTYPE_GRAPHIC THEN renderlink(fifox[fifoe],fifoy[fifoe],FILL_BACK)
  572.         renderlink(fifox[fifoe],fifoy[fifoe],FILL_LINK)
  573.         pushlink(hx,hy,head)
  574.         renderlink(hx,hy,FILL_HEAD)
  575.         IF (hx=cx) AND (hy=cy)
  576.             KsNotifyClients(krs,SNAKE_EATEN,chunk)
  577.             KsPlaySoundObject(efs)
  578.             eaten:=eaten+chunk
  579.             newchunk()
  580.         ENDIF
  581.         IF eaten
  582.             eaten:=eaten-1
  583.             KsNotifyClients(krs,SNAKE_NEWSCORE,fifol)
  584.             renderscore(TRUE,TRUE)
  585.         ELSE
  586.             x,y:=poplink()
  587.             renderlink(x,y,FILL_BACK)
  588.             transformtail(fifox[fifos],fifoy[fifos])
  589.             IF kp.fill[FILL_LINK].type=FILLTYPE_GRAPHIC THEN renderlink(fifox[fifos],fifoy[fifos],FILL_BACK)
  590.             renderlink(fifox[fifos],fifoy[fifos],FILL_LINK)
  591.         ENDIF
  592.     ENDIF
  593. ENDPROC alive
  594.  
  595. PROC resetgame(real=1)
  596.     DEF i
  597.     IF real
  598.         KsNotifyClients(krs,SNAKE_NEWGAME,NIL)
  599.         IF And(kp.flags,KPF_CONTSOUND)=0 THEN KsPlaySoundObject(bgs)
  600.     ENDIF
  601.     FOR i:=0 TO 1023 DO matrix[i]:=0
  602.     playing:=real
  603.     fifos:=0
  604.     fifoe:=1
  605.     fifol:=2
  606.     fifox[0]:=15
  607.     fifoy[0]:=16
  608.     fifox[1]:=15
  609.     fifoy[1]:=15
  610.     matrix[(15*32)+15]:=8
  611.     matrix[(16*32)+15]:=12
  612.     sx:=0
  613.     sy:=-1
  614.     head:=8
  615.     chunk:=0
  616.     eaten:=0
  617.     hx:=15
  618.     hy:=15
  619.     cx:=-1
  620.     cy:=-1
  621.     gameover:=0
  622.     paused:=0
  623.     IF real
  624.         newchunk()
  625.         renderscore()
  626.         rendersnake()
  627.     ENDIF
  628. ENDPROC
  629.  
  630. PROC waitimessage(win:PTR TO window)
  631.     DEF msg:PTR TO intuimessage,icl=0,ico=0,sigs=0
  632.     DEF jpv
  633.  
  634.     IF visible
  635.         WaitTOF()
  636.  
  637.         IF lowlevelbase
  638.             jpv:=ReadJoyPort(1) AND JP_DIRECTION_MASK
  639.             SELECT jpv
  640.                 CASE JPF_JOY_UP
  641.                     pushkey($4C)
  642.                 CASE JPF_JOY_DOWN
  643.                     pushkey($4D)
  644.                 CASE JPF_JOY_RIGHT
  645.                     pushkey($4E)
  646.                 CASE JPF_JOY_LEFT
  647.                     pushkey($4F)
  648.             ENDSELECT
  649.         ENDIF
  650.  
  651.         IF playing=0 THEN paused:=0
  652.         IF counter
  653.             counter:=counter-1
  654.         ELSE
  655.             counter:=speed
  656.             playing:=movesnake()
  657.         ENDIF
  658.  
  659.         WHILE KsGetNotifyEvent(krs,{icl},{ico})
  660.             SELECT icl
  661.                 CASE SNAKE_NEWPREFS
  662.                     killtask:=1
  663.                     newprefs:=1
  664.                     KsNotifyClients(krs,SNAKE_QUIT,NIL)
  665.             ENDSELECT
  666.         ENDWHILE
  667.  
  668.         WHILE (msg:=GetMsg(win.userport))
  669.             icl:=msg.class
  670.             ico:=msg.code
  671.             ReplyMsg(msg)
  672.             SELECT icl
  673.                 CASE IDCMP_CLOSEWINDOW
  674.                     killtask:=TRUE
  675.                 CASE IDCMP_REFRESHWINDOW
  676.                     render()
  677.                 CASE IDCMP_NEWSIZE
  678.                     verifysize()
  679.                     render()
  680.                 CASE IDCMP_INACTIVEWINDOW
  681.                     IF playing
  682.                         KsNotifyClients(krs,SNAKE_PAUSED,fifol)
  683.                         paused:=1
  684.                     ENDIF
  685.                 CASE IDCMP_RAWKEY
  686.                     IF ico=$45 THEN killtask:=TRUE
  687.                     pushkey(ico)
  688.             ENDSELECT
  689.         ENDWHILE
  690.         sigs:=SetSignal(0,0)
  691.         IF (sigs AND Shl(1,rexxPort.sigbit)) THEN checkRexxCommands()
  692.         IF (sigs AND Shl(1,brokerPort.sigbit)) THEN checkCxPort()
  693.     ELSE
  694.         sigs:=Wait(Shl(1,appPort.sigbit) OR Shl(1,brokerPort.sigbit) OR Shl(1,rexxPort.sigbit))
  695.         IF (sigs AND Shl(1,rexxPort.sigbit)) THEN checkRexxCommands()
  696.         IF (sigs AND Shl(1,brokerPort.sigbit)) THEN checkCxPort()
  697.         IF (sigs AND Shl(1,appPort.sigbit)) THEN checkAppPort()
  698.     ENDIF
  699. ENDPROC
  700.  
  701. PROC checkCxPort()
  702.     DEF msg:PTR TO mn,id,type
  703.     WHILE (msg:=GetMsg(brokerPort))
  704.         id:=CxMsgID(msg)
  705.         type:=CxMsgType(msg)
  706.         SELECT type
  707.             CASE CXM_IEVENT
  708.                 SELECT id
  709.                     CASE CXID_POPKEY
  710.                         IF visible THEN vanish() ELSE appear()
  711.                 ENDSELECT
  712.             CASE CXM_COMMAND
  713.                 SELECT id
  714.                     CASE CXCMD_KILL
  715.                         killtask:=1
  716.                     CASE CXCMD_DISAPPEAR
  717.                         IF visible THEN vanish()
  718.                     CASE CXCMD_APPEAR
  719.                         IF visible=0 THEN appear()
  720.                     CASE CXCMD_UNIQUE
  721.                         IF visible=0 THEN appear()
  722.                 ENDSELECT
  723.         ENDSELECT
  724.         ReplyMsg(msg)
  725.     ENDWHILE
  726. ENDPROC
  727.  
  728. PROC checkAppPort()
  729.     DEF msg:PTR TO appmessage
  730.     WHILE (msg:=GetMsg(appPort))
  731.         IF msg.numargs>0
  732.             DisplayBeep(NIL)
  733.         ELSE
  734.             appear()
  735.         ENDIF
  736.         ReplyMsg(msg)
  737.     ENDWHILE
  738. ENDPROC
  739.  
  740. PROC uffGetMsg(port,uff:PTR TO LONG)
  741.     DEF m,s
  742.     m,s:=rx_GetMsg(port)
  743.     ^uff:=s
  744. ENDPROC m
  745.  
  746. PROC checkRexxCommands()
  747.     DEF msg,rc,a,b,st[32]:STRING,sr:PTR TO CHAR,
  748.         ps:PTR TO LONG,cs[256]:STRING
  749.     IF rexxwaitmode<>0 THEN RETURN
  750.     WHILE (rexxwaitmode=0) AND (msg:=uffGetMsg(rexxPort,{ps}))
  751.         rc:=0
  752.         sr:=0
  753.         StrCopy(cs,ps)
  754.         UpperStr(cs)
  755.         ps:=argSplit(cs)
  756.         SELECT AREXX_MAX OF getRexxId(ps[0])
  757.             CASE AREXX_UP
  758.                 IF playing
  759.                     pushkey($4C)
  760.                     rc:=RC_OK
  761.                 ELSE
  762.                     rc:=RC_WARN
  763.                 ENDIF
  764.             CASE AREXX_DOWN
  765.                 IF playing
  766.                     pushkey($4D)
  767.                     rc:=RC_OK
  768.                 ELSE
  769.                     rc:=RC_WARN
  770.                 ENDIF
  771.             CASE AREXX_RIGHT
  772.                 IF playing
  773.                     pushkey($4E)
  774.                     rc:=RC_OK
  775.                 ELSE
  776.                     rc:=RC_WARN
  777.                 ENDIF
  778.             CASE AREXX_LEFT
  779.                 IF playing
  780.                     pushkey($4F)
  781.                     rc:=RC_OK
  782.                 ELSE
  783.                     rc:=RC_WARN
  784.                 ENDIF
  785.             CASE AREXX_QUIT
  786.                 killtask:=1
  787.                 rc:=RC_OK
  788.             CASE AREXX_NEWGAME
  789.                 IF playing=0
  790.                     pushkey($40)
  791.                     rc:=RC_OK
  792.                 ELSE
  793.                     rc:=RC_WARN
  794.                 ENDIF
  795.             CASE AREXX_HIDE
  796.                 IF visible
  797.                     vanish()
  798.                     rc:=RC_OK
  799.                 ELSE
  800.                     rc:=RC_WARN
  801.                 ENDIF
  802.             CASE AREXX_SHOW
  803.                 IF visible=0
  804.                     appear()
  805.                     rc:=RC_OK
  806.                 ELSE
  807.                     rc:=RC_WARN
  808.                 ENDIF
  809.             CASE AREXX_WAIT
  810.                 IF playing
  811.                     IF StrCmp(ps[1],'UNTIL')
  812.                         IF StrCmp(ps[2],'X')
  813.                             rexxwaitmode:=1
  814.                             rexxwait:=Val(ps[3])
  815.                             rc:=RC_OK
  816.                         ELSEIF StrCmp(ps[2],'Y')
  817.                             rexxwaitmode:=2
  818.                             rexxwait:=Val(ps[3])
  819.                             rc:=RC_OK
  820.                         ENDIF
  821.                     ELSEIF StrCmp(ps[1],'FOR')
  822.                         rexxwaitmode:=3
  823.                         rexxwait:=Val(ps[2])
  824.                         rc:=RC_OK
  825.                     ELSE
  826.                         rc:=RC_ERROR
  827.                     ENDIF
  828.                 ELSE
  829.                     rc:=RC_WARN
  830.                 ENDIF
  831.             CASE AREXX_SET
  832.                 IF StrCmp(ps[1],'SPEED')
  833.                     speed:=Val(ps[2])
  834.                     rc:=RC_OK
  835.                 ELSE
  836.                     rc:=RC_ERROR
  837.                 ENDIF
  838.             CASE AREXX_GET
  839.                 IF StrCmp(ps[1],'FRUIT')
  840.                     IF StrCmp(ps[2],'X')
  841.                         StringF(st,'\d',cx)
  842.                         sr:=st
  843.                         rc:=RC_OK
  844.                     ELSEIF StrCmp(ps[2],'Y')
  845.                         StringF(st,'\d',cy)
  846.                         sr:=st
  847.                         rc:=RC_OK
  848.                     ELSE
  849.                         rc:=RC_ERROR
  850.                     ENDIF
  851.                 ELSEIF StrCmp(ps[1],'HEAD')
  852.                     IF StrCmp(ps[2],'X')
  853.                         StringF(st,'\d',hx)
  854.                         sr:=st
  855.                         rc:=RC_OK
  856.                     ELSEIF StrCmp(ps[2],'Y')
  857.                         StringF(st,'\d',hy)
  858.                         sr:=st
  859.                         rc:=RC_OK
  860.                     ELSE
  861.                         rc:=RC_ERROR
  862.                     ENDIF
  863.                 ELSEIF StrCmp(ps[1],'LENGTH')
  864.                     IF playing
  865.                         StringF(st,'\d',fifol)
  866.                         sr:=st
  867.                         rc:=RC_OK
  868.                     ELSE
  869.                         rc:=RC_WARN
  870.                     ENDIF
  871.                 ELSEIF StrCmp(ps[1],'PLAYING')
  872.                     StringF(st,'\d',playing)
  873.                     sr:=st
  874.                     rc:=RC_OK
  875.                 ELSE
  876.                     rc:=RC_ERROR
  877.                 ENDIF
  878.             CASE AREXX_PAUSE
  879.                 IF playing
  880.                     KsNotifyClients(krs,SNAKE_PAUSED,fifol)
  881.                     paused:=1
  882.                     rc:=RC_OK
  883.                 ELSE
  884.                     rc:=RC_WARN
  885.                 ENDIF
  886.             CASE AREXX_CHECK
  887.                 IF playing
  888.                     b:=Val(ps[1])
  889.                     a:=Val(ps[2])
  890.                     StringF(st,'\d',matrix[Shl(a,5)+b])
  891.                     sr:=st
  892.                     rc:=RC_OK
  893.                 ELSE
  894.                     rc:=RC_WARN
  895.                 ENDIF
  896.             DEFAULT
  897.                 rc:=RC_ERROR
  898.         ENDSELECT
  899.         rx_ReplyMsg(msg,rc,sr)
  900.         DisposeLink(ps)
  901.     ENDWHILE
  902. ENDPROC
  903.  
  904. PROC openKRSNAkeLib()
  905.     DEF base=0:PTR TO lib
  906.     base:=OpenLibrary('krsnake.library',1)
  907.     IF base=0 THEN OpenLibrary('Libs/krsnake.library',1)
  908.     IF base=0 THEN OpenLibrary('PROGDIR:Libs/krsnake.library',1)
  909.     IF base
  910.         IF base.revision<6
  911.             CloseLibrary(base)
  912.             Throw("LIB",getstr(ERRORID_OLDKRSNAKELIB))
  913.         ENDIF
  914.     ENDIF
  915. ENDPROC base
  916.  
  917. PROC createBroker()
  918.     brokerPort:=CreateMsgPort()
  919.     broker:=CxBroker([NB_VERSION,0,
  920.                       'KRSNAke',KRSNAKEVER,
  921.                       getstr(ID_BROKERINFO),
  922.                       NBU_UNIQUE,COF_SHOW_HIDE,0,0,
  923.                       brokerPort,0]:newbroker,NIL)
  924.     AttachCxObj(broker,hotKey(kp.popkey,brokerPort,CXID_POPKEY))
  925.     ActivateCxObj(broker,TRUE)
  926. ENDPROC broker
  927.  
  928. PROC initrexx()
  929.     rexxPort:=rx_OpenPort('KRSNAKE')
  930.     NEW rexxhash.hashtable(HASH_NORMAL)
  931.     addRexxCommand('CHECK',AREXX_CHECK)
  932.     addRexxCommand('DOWN',AREXX_DOWN)
  933.     addRexxCommand('GET',AREXX_GET)
  934.     addRexxCommand('HIDE',AREXX_HIDE)
  935.     addRexxCommand('LEFT',AREXX_LEFT)
  936.     addRexxCommand('NEWGAME',AREXX_NEWGAME)
  937.     addRexxCommand('PAUSE',AREXX_PAUSE)
  938.     addRexxCommand('QUIT',AREXX_QUIT)
  939.     addRexxCommand('RIGHT',AREXX_RIGHT)
  940.     addRexxCommand('SET',AREXX_SET)
  941.     addRexxCommand('SHOW',AREXX_SHOW)
  942.     addRexxCommand('UP',AREXX_UP)
  943.     addRexxCommand('WAIT',AREXX_WAIT)
  944. ENDPROC
  945.  
  946. PROC endrexx()
  947.     IF rexxPort THEN rx_ClosePort(rexxPort)
  948.     END rexxhash
  949. ENDPROC
  950.  
  951. PROC addRexxCommand(cmd:PTR TO CHAR,id)
  952.     DEF hl:PTR TO rexxcommand,hv
  953.     hl,hv:=rexxhash.find(cmd,StrLen(cmd))
  954.     IF hl THEN RETURN FALSE
  955.     NEW hl
  956.     hl.id:=id
  957.     rexxhash.add(hl,hv,cmd,StrLen(cmd))
  958. ENDPROC
  959.  
  960. PROC getRexxId(cmd:PTR TO CHAR)
  961.     DEF hl:PTR TO rexxcommand
  962.     hl:=rexxhash.find(cmd,StrLen(cmd))
  963.     IF hl=0 THEN RETURN 0
  964.     RETURN hl.id
  965. ENDPROC
  966.  
  967. PROC appear()
  968.     IF visible=0
  969.         IF appicon THEN RemoveAppIcon(appicon)
  970.         IF appmenu THEN RemoveAppMenuItem(appmenu)
  971.         appicon:=0;appmenu:=0
  972.         IF StrLen(kp.pubscreen)
  973.             s:=LockPubScreen(kp.pubscreen)
  974.         ELSE
  975.             s:=LockPubScreen(NIL)
  976.         ENDIF
  977.         font:=OpenFont(s.font)
  978.         dri:=GetScreenDrawInfo(s)
  979.         dripens:=dri.pens
  980.         th:=font.ysize
  981.         IF wy=-1 THEN wy:=s.barheight+1
  982.         ww:=fw+8
  983.         wh:=fh+th+14
  984.         IF wantobtainpens THEN obtainpens()
  985.         IF And(kp.flags,KPF_FREESOUNDS) THEN readsounds()
  986.         w:=OpenWindowTagList(NIL,[WA_INNERWIDTH,ww,WA_INNERHEIGHT,wh,
  987.                                   WA_LEFT,wx,WA_TOP,wy,
  988.                                   WA_TITLE,'KRSNAke v1.17',
  989.                                   WA_SIZEGADGET,TRUE,
  990.                                   WA_DRAGBAR,TRUE,
  991.                                   WA_DEPTHGADGET,TRUE,
  992.                                   WA_CLOSEGADGET,TRUE,
  993.                                   WA_ACTIVATE,TRUE,
  994.                                   WA_SMARTREFRESH,TRUE,
  995.                                   WA_SIZEBBOTTOM,TRUE,
  996.                                   WA_GIMMEZEROZERO,TRUE,
  997.                                   WA_NEWLOOKMENUS,TRUE,
  998.                                   WA_SCREENTITLE,'KRSNAke v1.17 - IGNE NATURA RENOVATUR INTEGRA!',
  999.                                   WA_AUTOADJUST,TRUE,
  1000.                                   WA_PUBSCREEN,s,
  1001.                                   WA_RMBTRAP,TRUE,
  1002.                                   WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_REFRESHWINDOW OR IDCMP_INACTIVEWINDOW OR IDCMP_NEWSIZE OR IDCMP_RAWKEY,
  1003.                                   NIL])
  1004.         WindowLimits(w,w.borderleft+w.borderright+136,w.bordertop+w.borderbottom+th+142,-1,-1)
  1005.         SetStdRast(w.rport)
  1006.         SetFont(stdrast,font)
  1007.         render()
  1008.         visible:=1
  1009.         IF krs THEN KsShowInterface(krs)
  1010.         IF And(kp.flags,KPF_CONTSOUND) THEN IF And(kp.flags,KPF_FREESOUNDS) THEN KsPlaySoundObject(bgs)
  1011.     ENDIF
  1012. ENDPROC
  1013.  
  1014. PROC vanish(forever=FALSE)
  1015.     IF visible
  1016.         IF w THEN CloseWindow(w)
  1017.         IF And(kp.flags,KPF_FREESOUNDS) THEN freesounds()
  1018.         IF pensobtained THEN freepens()
  1019.         IF dri THEN FreeScreenDrawInfo(s,dri)
  1020.         IF font THEN CloseFont(font)
  1021.         IF s THEN UnlockPubScreen(NIL,s)
  1022.         IF playing=1 THEN paused:=1
  1023.         IF krs THEN KsHideInterface(krs)
  1024.         w:=0;pensobtained:=0;dri:=0;font:=0;s:=0;visible:=0
  1025.         IF forever=0
  1026.             IF And(kp.flags,KPF_APPICON) THEN appicon:=AddAppIconA(APPID_ICON,0,'KRSNAke',appPort,NIL,myicon,NIL)
  1027.             IF And(kp.flags,KPF_APPMENU) THEN appmenu:=AddAppMenuItemA(APPID_MENU,0,'KRSNAke',appPort,NIL)
  1028.         ENDIF
  1029.     ENDIF
  1030. ENDPROC
  1031.  
  1032. PROC main() HANDLE
  1033. ->    trapguru()
  1034.     randomise()
  1035.     IF (krsnakebase:=openKRSNAkeLib())=0 THEN Throw("LIB",'krsnake.library')
  1036.     IF (utilitybase:=OpenLibrary('utility.library',37))=0 THEN Throw("LIB",'utility.library')
  1037.     IF (cxbase:=OpenLibrary('commodities.library',37))=0 THEN Throw("LIB",'commodities.library')
  1038.     IF (iconbase:=OpenLibrary('icon.library',37))=0 THEN Throw("LIB",'icon.library')
  1039.     IF (workbenchbase:=OpenLibrary('workbench.library',37))=0 THEN Throw("LIB",'workbench.library')
  1040.     datatypesbase:=OpenLibrary('datatypes.library',39)
  1041.     localebase:=OpenLibrary('locale.library',37)
  1042.     openCatalog()
  1043.     IF (lowlevelbase:=OpenLibrary('lowlevel.library',40)) THEN SetJoyPortAttrsA(1,[SJA_TYPE,SJA_TYPE_JOYSTK,NIL])
  1044.     myicon:=GetDiskObjectNew('PROGDIR:KRSNAke')
  1045.     krs:=KsRegisterServer()
  1046.     launchclients()
  1047.     readsettings()
  1048.     resetgame(0)
  1049.     SetTaskPri(FindTask(NIL),kp.priority)
  1050.     IF And(kp.flags,KPF_FREESOUNDS)=0 THEN readsounds()
  1051.     appPort:=CreateMsgPort()
  1052.     createBroker()
  1053.     initrexx()
  1054.     appear()
  1055.     IF And(kp.flags,KPF_CONTSOUND) THEN IF And(kp.flags,KPF_FREESOUNDS)=0 THEN KsPlaySoundObject(bgs)
  1056.  
  1057.     checkStubing()
  1058.  
  1059.     REPEAT
  1060.         waitimessage(w)
  1061.     UNTIL killtask
  1062.  
  1063.     dumpsettings()
  1064.  
  1065. EXCEPT DO
  1066.     vanish(TRUE)
  1067.     closeCatalog()
  1068.     IF krs THEN KsRemoveServer(krs)
  1069.     IF rexxPort THEN endrexx()
  1070.     IF broker THEN DeleteCxObj(broker)
  1071.     IF brokerPort THEN deletePortSafely(brokerPort)
  1072.     IF appicon THEN RemoveAppIcon(appicon)
  1073.     IF appmenu THEN RemoveAppMenuItem(appmenu)
  1074.     IF appPort THEN deletePortSafely(appPort)
  1075.     IF myicon THEN FreeDiskObject(myicon)
  1076.     IF kp THEN FreeVec(kp)
  1077.     freesounds()
  1078.     IF krsnakebase THEN CloseLibrary(krsnakebase)
  1079.     IF localebase THEN CloseLibrary(localebase)
  1080.     IF utilitybase THEN CloseLibrary(utilitybase)
  1081.     IF iconbase THEN CloseLibrary(iconbase)
  1082.     IF workbenchbase THEN CloseLibrary(workbenchbase)
  1083.     IF cxbase THEN CloseLibrary(cxbase)
  1084.     IF lowlevelbase THEN CloseLibrary(lowlevelbase)
  1085.     IF datatypesbase THEN CloseLibrary(datatypesbase)
  1086.     IF exception>0 THEN report_exception() ELSE IF newprefs THEN RETURN reLaunch()
  1087. ENDPROC
  1088.  
  1089. PROC report_exception()
  1090.   DEF e[5]:ARRAY,s[256]:STRING,t[256]:STRING
  1091.   IF exception
  1092.     StrCopy(s,getstr(ERRORID_EXCEPTION))
  1093.     IF exception<10000
  1094.       StringF(t,' \d\n',exception)
  1095.       StrAdd(s,t)
  1096.     ELSE
  1097.       SELECT exception
  1098.         CASE  "MEM"; StrCopy(t,getstr(ERRORID_MEM))
  1099.         CASE "OPEN"; lStringF(t,getstr(ERRORID_OPEN),[IF exceptioninfo THEN exceptioninfo ELSE ''])
  1100.         CASE "LOCK"; lStringF(t,getstr(ERRORID_LOCK),[IF exceptioninfo THEN exceptioninfo ELSE ''])
  1101.         CASE  "WIN"; lStringF(t,getstr(ERRORID_WIN),[IF exceptioninfo THEN exceptioninfo ELSE ''])
  1102.         CASE  "LIB"; lStringF(t,getstr(ERRORID_LIB),[IF exceptioninfo THEN exceptioninfo ELSE ''])
  1103.         CASE  "SCR"; lStringF(t,getstr(ERRORID_SCR),[IF exceptioninfo THEN exceptioninfo ELSE ''])
  1104.         CASE   "^C"; StrCopy(t,getstr(ERRORID_BREAK))
  1105.         CASE "DOUB"; StrCopy(t,getstr(ERRORID_DOUB))
  1106.         CASE  "SIG"; StrCopy(t,getstr(ERRORID_SIG))
  1107.         CASE "CXBR"; StrCopy(t,getstr(ERRORID_CXBR))
  1108.         DEFAULT
  1109.           e[4]:=0
  1110.           ^e:=exception
  1111.           WHILE e[]=0 DO e++
  1112.           StringF(t,IF exceptioninfo<1000 THEN '"\s" [\d]' ELSE '"\s" [\s]',e,exceptioninfo)
  1113.       ENDSELECT
  1114.       StrAdd(s,t)
  1115.     ENDIF
  1116.     EasyRequestArgs(NIL,[SIZEOF easystruct,0,getstr(ID_EXCEPTION),s,getstr(ABOUTID_OK)],NIL,NIL)
  1117.   ENDIF
  1118. ENDPROC
  1119.  
  1120. PROC reLaunch()
  1121.     DEF p[1024]:ARRAY OF CHAR,n[256]:ARRAY OF CHAR
  1122.     NameFromLock(GetProgramDir(),p,1024)
  1123.     IF GetProgramName(n,256)=0 THEN StrCopy(n,'KRSNAke')
  1124.     AddPart(p,n,1024)
  1125.     RETURN launchClient(p)
  1126. ENDPROC
  1127.  
  1128. PROC checkStubing()
  1129.     DEF cd:PTR TO clockdata,secs:LONG,micros:LONG
  1130.     NEW cd
  1131.     CurrentTime({secs},{micros})
  1132.     Amiga2Date(secs,cd)
  1133.     IF (cd.mday=28) AND (cd.month=2) THEN EasyRequestArgs(NIL,[SIZEOF easystruct,0,'Halelujah!','Today, Gavin MacLeod is %ld years old!\n\nHappy Birthday, Captain Stubing!','Rejoice!'],NIL,[cd.year-1930])
  1134.     IF (cd.mday=8) AND (cd.month=1) THEN EasyRequestArgs(NIL,[SIZEOF easystruct,0,'Elvis be praised!','Today the King is %ld years old!\nEnter your congratulation in alt.elvis.king now!','You ain''t nuthin'' but a hound dog!'],NIL,[cd.year-1935])
  1135.     IF (cd.mday=13) AND (cd.month=10) THEN EasyRequestArgs(NIL,[SIZEOF easystruct,0,'Fnord!','On this very day, %ld years ago,\nJacques de Molay was arrested!','Good riddance!'],NIL,[cd.year-1307])
  1136.     END cd
  1137. ENDPROC
  1138.  
  1139. krsnakever: CHAR '$VER: KRSNAke 1.017 (22 Feb 1996)',0
  1140.  
  1141.  
  1142.